home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 005 / pcpm.arc / CPADAYS.BAS (.txt) < prev    next >
Encoding:
GW-BASIC  |  1985-06-04  |  3.0 KB  |  115 lines
  1. 10  REM **** CPADAYS ****
  2. 20  CLOSE
  3. 100  DEFINT B-Z:DEFSNG A
  4. 110  DIM A(3000),A3(100),X$(12)
  5. 130  FOR I=1 TO 12
  6. 140  READ X$(I)
  7. 150  NEXT I
  8. 160  DATA "JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC"
  9. 170  GOSUB 5000  'READ INPUT FILE
  10. 175  INPUT "Enter project length (days) ",Z9
  11. 180  Z7=1
  12. 190  D1=1
  13. 200  GOSUB 1000           'GET DAY OF CENTURY - A8
  14. 205  ON ERROR GOTO 700
  15. 210  PRINT:PRINT "**** READING HOLIDAY FILE: ";F$;".HOL ****"
  16. 220  GOSUB 8000
  17. 295  PRINT "**** CALCULATING DAYS - TAKES"1+Z9/10"SECONDS ****"
  18. 300  GOSUB 1070     'CREATE ARRAY OF MMDDYYS
  19. 310  INPUT "Want a Particular day, Whole printout, or End (P/W/E) ",Q$
  20. 320  IF LEFT$(Q$,1)="E" THEN 630
  21. 330  IF LEFT$(Q$,1)="W" THEN 420
  22. 350  INPUT "Enter the project day number ",Z2
  23. 360  IF Z2<Z9+1 THEN 380 ELSE PRINT "**** ERROR - GREATER THAN PROJECT LENGTH ****":BEEP
  24. 370  GOTO 350
  25. 380  A6=A(Z2+1)
  26. 390  GOSUB 1350
  27. 400  PRINT "**** DAY";Z2;"IS ";P6$;" ****"
  28. 410  GOTO 310
  29. 420  OPEN F$+".DAY" FOR OUTPUT AS #2
  30. 440  PRINT #2,G9$
  31. 450  PRINT #2,"      WORKING DAY TO PROJECT DAY NUMBERS FOR: ";P$
  32. 460  PRINT #2,G9$
  33. 470  PRINT #2,"    COL  1      2      3      4      5      6      7      8      9     10"
  34. 480  PRINT #2,"  ROW"
  35. 490  I=0
  36. 500  PRINT #2, USING " #### ";I;
  37. 510  FOR I=1 TO Z9+1
  38. 520  PRINT #2, USING "###### ";A(I);
  39. 530  IF INT(I/10)=I/10 THEN PRINT #2,G9$ ELSE 550
  40. 540  PRINT #2, USING " #### ";I;
  41. 550  NEXT I
  42. 560  PRINT #2,G9$
  43. 570  PRINT #2,G9$
  44. 580  PRINT #2,"          NOTE: ADD COLUMN NUMBER TO ROW NUMBER TO GET PROJECT DAY NUMBER"
  45. 590  CLOSE #2
  46. 600  PRINT "**** ";F$;".DAY HAS BEEN CREATED ****"
  47. 610  PRINT
  48. 620  INPUT "Press ENTER to continue ",Q$
  49. 630  CHAIN "CPAMENU"
  50. 700  PRINT "**** NO HOLIDAY FILE - CONTINUING ****":RESUME 295
  51. 1000  L8=2
  52. 1010  IF INT(Y6/4)=Y6/4 THEN L8=1
  53. 1020  D7=INT(M6*275/9)+D6-30
  54. 1030  IF M6>2 THEN D7=D7-L8
  55. 1040  A8=INT((Y6-1)*1461/4)+D7
  56. 1050  A9=A8
  57. 1060  RETURN
  58. 1070  A(1)=M6*10000+D6*100+Y6
  59. 1080  D1=D1+1
  60. 1090  IF D1>Z9+1 THEN RETURN
  61. 1100  A8=A8+1
  62. 1110  GOSUB 1190
  63. 1120  IF LEFT$(T6$,3)="CAL" THEN 1130 ELSE IF D4=6 OR D4=7 THEN 1100
  64. 1130  O8=0
  65. 1140  GOSUB 1310
  66. 1150  IF O8=1 THEN 1100
  67. 1160  A(D1)=M5*10000+D5*100+Y5
  68. 1170  GOTO 1080
  69. 1180  REM ** CONVERT CENTURY DAY TO MM, DD, YY **************************
  70. 1190  T9=INT(A8/1461)
  71. 1200  Y5=INT((A8-T9+364)/365)
  72. 1210  Y4=A8-INT((Y5-1)*1461/4)
  73. 1220  L8=2
  74. 1230  IF Y5/4=INT(Y5/4) THEN L8=1
  75. 1240  T9=Y4
  76. 1250  IF T9>61-L8 THEN T9=T9+L8
  77. 1260  M5=INT((T9*9+269)/275)
  78. 1270  D5=T9-INT(M5*275/9)+30
  79. 1280  D4=A8-INT(A8/7)*7+1
  80. 1290  RETURN
  81. 1300  REM ** HOLIDAY OR NOT ******************************************
  82. 1310  FOR J=1 TO H9
  83. 1320  IF A8=A3(J) THEN O8=1
  84. 1330  NEXT J
  85. 1340  RETURN
  86. 1350  P6$=STR$(A6)
  87. 1360  IF LEN(P6$)=5 THEN P6$=" "+P6$
  88. 1370  U9=VAL(LEFT$(P6$,2))
  89. 1380  P6$=X$(U9)+RIGHT$(P6$,4)
  90. 1390  RETURN
  91. 5000  REM **** READING IN ALREADY CREATED INPUT FILE ******************
  92. 5010  INPUT "Enter the name of the input file [.CPM] ";G$
  93. 5015  IF G$="Q" OR G$="QUIT" THEN 3500
  94. 5020  P=INSTR(1,G$,"."):IF P<>0 THEN F$=LEFT$(G$,INSTR(1,G$,".")-1) ELSE F$=G$
  95. 5030  IF LEN(F$)>8 THEN PRINT "**** NOT A VALID PCPM FILE ****":BEEP:GOTO 5010
  96. 5035  ON ERROR GOTO 5300
  97. 5037  G$=F$+".CPM"
  98. 5040  OPEN G$ FOR INPUT AS #3
  99. 5050  INPUT #3,P$,T6$,DA$
  100. 5060  M6=VAL(LEFT$(DA$,2)):D6=VAL(MID$(DA$,3,2)):Y6=VAL(RIGHT$(DA$,2))
  101. 5070  CLOSE #3
  102. 5080  PRINT " **** INPUT FILE READ ****"
  103. 5090  RETURN
  104. 5300  PRINT "**** FILE DOES NOT EXIST - TRY AGAIN ****":BEEP:GOTO 5000
  105. 8000  ON ERROR GOTO 8200
  106. 8010  OPEN F$+".HOL" FOR INPUT AS #1
  107. 8020  J=0
  108. 8030  J=J+1
  109. 8040  IF EOF(1) THEN 8100
  110. 8050  INPUT #1,A3(J)
  111. 8060  GOTO 8030
  112. 8100  H9=J-1  'NUMBER OF HOLIDAYS
  113. 8110  CLOSE #1:RETURN
  114. 8200  PRINT "**** NO HOLIDAY FILE - CONTINUING ****":RESUME 8110
  115.